home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0030_Another Device in TP.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  5KB  |  193 lines

  1. {
  2. I've written a simple device driver in TP, and it works.  From some things I've
  3. heard, it won't work in all versions of DOS (it's an .EXE format device driver,
  4. not a .BIN format one).  There are tons of restrictions on what you can do in
  5. it - DOS isn't reentrant, and the TP system library isn't designed to do things
  6. while DOS is active, so I don't even let it get initialized, etc., etc.
  7.  
  8. It's still a bit of a mess, but here it is, for your enjoyment and edification:
  9.  a character device driver that keeps a buffer of 255 characters, called
  10. TPDEVICE.
  11.  
  12. To try it out, compile it (you'll need OPro or TPro; sorry, but stack swapping
  13. is essential, and I wouldn't want to try to write code to do it myself), put it
  14. into your CONFIG.SYS (on a floppy disk, please!) as
  15.  
  16.   device=tpdev.exe
  17.  
  18. and then reboot.   Hopefully you won't crash, but if you do, you'll have to
  19. reboot from a different disk and remove it from CONFIG.SYS.
  20.  
  21. Then you can try
  22.  
  23.   COPY TPDEVICE CON
  24.  
  25. to see the initialization message, and
  26.  
  27.   ECHO This is a line for the buffer >TPDEVICE
  28.  
  29. to replace it with a new one.
  30. }
  31. { DOS character device driver written entirely in TP 6 }
  32.  
  33. { Written by D.J. Murdoch for the public domain, May 1991 }
  34.  
  35. {$S-,F-}       { Stack checking wouldn't work here, and we assume near calls }
  36. {$M $1000,0,0} { We can't use the heap and don't use the stack.  This
  37.                  setting doesn't really matter though, since you normally
  38.                  won't run TPDEV }
  39.  
  40. program tpdev;
  41.  
  42. uses
  43.   opint;  { OPro interrupt services, needed for stack switching }
  44.  
  45. procedure strategy_routine(bp:word); interrupt; forward;
  46. procedure interrupt_routine(bp:word); interrupt; forward;
  47.  
  48. procedure header; assembler;
  49. { Here's the trick:  an assembler routine in the main program, guaranteed to
  50.   be linked first in the .EXE file!!}
  51. asm
  52.   dd $FFFFFFFF    { next driver }
  53.   dw $8000        { attributes of simple character device }
  54.   dw offset strategy_routine
  55.   dw offset interrupt_routine
  56.   db 'TPDEVICE'
  57. end;
  58.  
  59. const
  60.   stDone = $100;
  61.   stBusy = $200;
  62.  
  63.   cmInit  = 0;
  64.   cmInput = 4;
  65.   cmInput_no_wait = 5;
  66.   cmInput_status  = 6;
  67.   cmInput_flush   = 7;
  68.   cmOutput        = 8;
  69.   cmOutput_Verify = 9;
  70.   cmOutput_status = 10;
  71.   cmOutput_flush  = 11;
  72.  
  73. type
  74.   request_header = record
  75.     request_length : byte;
  76.     subunit        : byte;
  77.     command_code   : byte;
  78.     status         : word;
  79.     reserved       : array[1..8] of byte;
  80.     case byte of
  81.       cmInit : (num_units  : byte;
  82.                 first_free : pointer;
  83.                 args       : ^char;
  84.                 drive_num  : byte;);
  85.       cmInput :  { also used for output }
  86.                (media_descriptor : byte;
  87.                buffer            : pointer;
  88.                byte_count        : word);
  89.       cmInput_no_wait : (next_char : char);
  90.   end;
  91.  
  92. var
  93.   local_stack  : array[1..4000] of byte;
  94.   end_of_stack : byte;
  95.   request      : ^request_header;
  96.   line         : string;
  97.  
  98. procedure handler(var regs : intregisters);
  99. { This routine is called by the strategy routine, and handles all requests.
  100.   The data segment is okay, and we're running on the local_stack so we've got
  101.  plenty of space, but remember:
  102.    ****** The initialization code for SYSTEM and all other units hasn't
  103.           ever been called!!  ******** }
  104. begin
  105.   with request^ do
  106.   begin
  107.     case command_code of
  108.  
  109.       cmInit :
  110.       begin
  111.         { Last thing in the data segment in TP6 - No heap!!}
  112.         first_free := ptr(dseg, ofs(saveint75) + 4);
  113.         status     := stDone;
  114.         line       := 'TPDRIVER successfully initialized.';
  115.       end;
  116.  
  117.       cmInput :
  118.       begin
  119.         if byte_count > length(line) then
  120.           byte_count := length(line);
  121.         move(line[1], buffer^, byte_count);
  122.         line := copy(line, byte_count + 1, 255);
  123.         status := stDone;
  124.       end;
  125.  
  126.       cmInput_no_wait :
  127.       begin
  128.         if length(line) > 0 then
  129.         begin
  130.           next_char := line[1];
  131.           status := stDone;
  132.         end
  133.         else
  134.           status := stBusy;
  135.       end;
  136.  
  137.       cmInput_Status,
  138.       cmOutput_Status,
  139.       cmInput_Flush,
  140.       cmOutput_Flush : status := stDone;
  141.  
  142.       cmOutput,
  143.       cmOutput_Verify :
  144.       begin
  145.         if byte_count + length(line) > 255 then
  146.           byte_count := 255 - length(line);
  147.         move(buffer^, line[length(line) + 1], byte_count);
  148.         line[0] := char(byte(byte_count + length(line)));
  149.         status := stDone;
  150.       end;
  151.     end;
  152.   end;
  153. end;
  154.  
  155. procedure RetFar; assembler;
  156. { Replacement for the IRET code that ends the interrupt routines below }
  157. asm
  158.   mov sp,bp
  159.   pop bp
  160.   pop es
  161.   pop ds
  162.   pop di
  163.   pop si
  164.   pop dx
  165.   pop cx
  166.   pop bx
  167.   pop ax
  168.   retf
  169. end;
  170.  
  171. procedure strategy_routine(bp : word);
  172. var
  173.   regs : intregisters absolute bp;
  174. begin
  175.   with regs do
  176.     request := ptr(es, bx);
  177.   RetFar;
  178. end;
  179.  
  180. procedure interrupt_routine(bp : word);
  181. var
  182.   regs : intregisters absolute bp;
  183. begin
  184.   SwapStackandCallNear(Ofs(handler), @end_of_stack, regs);
  185.   RetFar;
  186. end;
  187.  
  188. begin
  189.   writeln('TPDEVICE - DOS device driver written *entirely* in Turbo Pascal.');
  190.   writeln('Install using DEVICE=TPDEV.EXE in CONFIG.SYS.');
  191.   request := @header;  { Need a reference to pull in the header. }
  192. end.
  193.